home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / tpznewg.zip / TPZ.U < prev    next >
Text File  |  1990-05-18  |  63KB  |  2,320 lines
  1. UNIT TPZ;
  2.  
  3. (*                           ZMODEM für Turbo-Pascal                           *)
  4. (*                                                                             *)
  5. (*                       Copywrite (c) by Stefan Graf 1990                     *)
  6. (*                                                                             *)
  7. (* Datenübertragung über die serielle Schnittstelle mit dem ZMODEM-Protokoll.  *)
  8. (* Als Grundlage diente der Sourcecode TPZ.PAS von Philip R. Burn's PIPTERM.   *)
  9. (* Die Unit ist in vielen Teilen überarbeitet und auf hohe Transferraten       *)
  10. (* getrimmt worden.                                                            *)
  11. (* In diversen Test's wurde mit 115200 Baud eine Übertragungsrate von mehr als *)
  12. (* 5 kByte's pro Sekunde erreicht.                                             *)
  13. (*                                                                             *)
  14. (* Das Handling der ser. Schnittstelle erfolgt über die Unit SERIELLINTERFACE. *)
  15. (*                                                                             *)
  16. (* Die Transferroutinen erzeugen selber keinerlei Statusmeldungen. Diese über- *)
  17. (* nehmen zwei, vom Benutzter zu erstellende parameterlose PROCEDUREN, die     *)
  18. (* den aktuellen Status des Transfer's ausgeben. Diese Daten werden in der     *)
  19. (* Variablen der Unit TRANSDATA abgelegt.                                      *)
  20.  
  21. INTERFACE
  22.  
  23.   CONST
  24.     ProgramVersion = '2.22ß';
  25.  
  26.  
  27.   VAR
  28.     MakeCRC32,               (* TRUE, wenn 32-Bit-CRC benutzt werden darf  *)
  29.     RecoverAllow : BOOLEAN;  (* TRUE, wenn das File-Recover zugelassen ist *)
  30.  
  31. (* Empfangen eines File mit dem ZMODEM-Protokoll *)
  32.  
  33. PROCEDURE ZmodemReceive (    path       : STRING;     (* Path für das File                      *)
  34.                              baudrate   : LONGINT;    (* Aktuelle Baudrate auf der Telefonseite *)
  35.                              kanal      : WORD;       (* Handlernummer für SeriellInterface     *)
  36.                              startproc,               (* Adresse der Start-Anzeige-Procedure    *)
  37.                              dispproc   : POINTER;    (* Adresse der Transfer-Anzeige-Procedure *)
  38.                          VAR fehlerflag : BOOLEAN);   (* TRUE, wenn ein Fehler aufgetreten ist  *)
  39.  
  40. (* Senden eines Files mit dem ZMODEM-Protokoll *)
  41.  
  42. PROCEDURE ZmodemSend    (    pathname   : STRING;     (* Path und Filename                      *)
  43.                              baudrate   : LONGINT;    (* Aktuelle Baudrate auf der Telefonseite *)
  44.                              lastfile   : BOOLEAN;    (* TRUE, wenn keine weitere Übertragung   *)
  45.                              kanal      : WORD;       (* Handlernummer für SeriellInterface     *)
  46.                              startproc,               (* Adresse der Start-Anzeige-Procedure    *)
  47.                              dispproc   : POINTER;    (* Adresse der Transfer-Anzeige-Procedure *)
  48.                          VAR fehler     : WORD);      (* Bei Fehler in der Übertragung <> 0     *)
  49.  
  50.  
  51. IMPLEMENTATION
  52.  
  53.   USES Crt,Dos,SeriellInterface,TransData,TPZFiles,TPZunix,TPZcrc;
  54.  
  55. CONST
  56.    ZBUFSIZE = 1024;
  57.  
  58.    zbaud: LONGINT = 0;
  59.  
  60.    txtimeout = 10 * 18;
  61.  
  62. TYPE
  63.    hdrtype = ARRAY[0..3] OF BYTE;
  64.    buftype = ARRAY[0..ZBUFSIZE] OF BYTE;
  65.  
  66. CONST
  67.    ZPAD = 42;  { '*' }
  68.    ZDLE = 24;  { ^X  }
  69.    ZDLEE = 88;
  70.    ZBIN = 65;  { 'A' }
  71.    ZHEX = 66;  { 'B' }
  72.    ZBIN32 = 67;{ 'C' }
  73.    ZRQINIT = 0;
  74.    ZRINIT = 1;
  75.    ZSINIT = 2;
  76.    ZACK = 3;
  77.    ZFILE = 4;
  78.    ZSKIP = 5;
  79.    ZNAK = 6;
  80.    ZABORT = 7;
  81.    ZFIN = 8;
  82.    ZRPOS = 9;
  83.    ZDATA = 10;
  84.    ZEOF = 11;
  85.    ZFERR = 12;
  86.    ZCRC = 13;
  87.    ZCHALLENGE = 14;
  88.    ZCOMPL = 15;
  89.    ZCAN = 16;
  90.    ZFREECNT = 17;
  91.    ZCOMMAND = 18;
  92.    ZSTDERR = 19;
  93.    ZCRCE = 104; { 'h' }
  94.    ZCRCG = 105; { 'i' }
  95.    ZCRCQ = 106; { 'j' }
  96.    ZCRCW = 107; { 'k' }
  97.    ZRUB0 = 108; { 'l' }
  98.    ZRUB1 = 109; { 'm' }
  99.    ZOK = 0;
  100.    ZERROR = -1;
  101.    ZTIMEOUT = -2;
  102.    RCDO = -3;
  103.    FUBAR = -4;
  104.    GOTOR = 256;
  105.    GOTCRCE = 360; { 'h' OR 256 }
  106.    GOTCRCG = 361; { 'i' "   "  }
  107.    GOTCRCQ = 362; { 'j' "   "  }
  108.    GOTCRCW = 363; { 'k' "   "  }
  109.    GOTCAN = 272;  { CAN OR  "  }
  110.  
  111. { xmodem paramaters }
  112.  
  113. CONST
  114.    ENQ = 5;
  115.    CAN = 24;
  116.    XOFF = 19;
  117.    XON = 17;
  118.    SOH = 1;
  119.    STX = 2;
  120.    EOT = 4;
  121.    ACK = 6;
  122.    NAK = 21;
  123.    CPMEOF = 26;
  124.  
  125. { byte positions }
  126. CONST
  127.    ZF0 = 3;
  128.    ZF1 = 2;
  129.    ZF2 = 1;
  130.    ZF3 = 0;
  131.    ZP0 = 0;
  132.    ZP1 = 1;
  133.    ZP2 = 2;
  134.    ZP3 = 3;
  135.  
  136. { bit masks for ZRINIT }
  137. CONST
  138.    CANFDX = 1;    { can handle full-duplex          (yes for PC's)}
  139.    CANOVIO = 2;   { can overlay disk and serial I/O (ditto)       }
  140.    CANBRK = 4;    { can send a break - True but superfluous       }
  141.    CANCRY = 8;    { can encrypt/decrypt - not defined yet         }
  142.    CANLZW = 16;   { can LZ compress - not defined yet             }
  143.    CANFC32 = 32;  { can use 32 bit crc frame checks - true        }
  144.    ESCALL = 64;   { escapes all control chars. NOT implemented    }
  145.    ESC8 = 128;    { escapes the 8th bit. NOT implemented          }
  146.  
  147. { bit masks for ZSINIT }
  148. CONST
  149.    TESCCTL = 64;
  150.    TESC8 = 128;
  151.  
  152. { paramaters for ZFILE }
  153. CONST
  154. { ZF0 }
  155.    ZCBIN = 1;
  156.    ZCNL = 2;
  157.    ZCRESUM = 3;
  158. { ZF1 }
  159.    ZMNEW = 1;   {I haven't implemented these as of yet - most are}
  160.    ZMCRC = 2;   {superfluous on a BBS - Would be nice from a comm}
  161.    ZMAPND = 3;  {programs' point of view however                 }
  162.    ZMCLOB = 4;
  163.    ZMSPARS = 5;
  164.    ZMDIFF = 6;
  165.    ZMPROT = 7;
  166. { ZF2 }
  167.    ZTLZW = 1;   {encryption, compression and funny file handling }
  168.    ZTCRYPT = 2; {flags - My docs (03/88) from OMEN say these have}
  169.    ZTRLE = 3;   {not been defined yet                            }
  170. { ZF3 }
  171.    ZCACK1 = 1;  {God only knows...                               }
  172.  
  173. VAR
  174.    {$IFDEF TPZLog}                (* Für Testzwecke kann man durch Setzen der    *)
  175.      tpzlog     : FILE OF CHAR;   (* Definition TPZLog ein Protokoll aller ge-   *)
  176.    {$ENDIF}                       (* sendeten und empfangenen Zeichen erzeugten. *)
  177.  
  178.    TimeCounter  : LONGINT ABSOLUTE $40:$6C;
  179.  
  180.    modemkanal   : WORD;
  181.  
  182.    rxpos        : LONGINT; {file position received from Z_GetHeader}
  183.    rxhdr        : hdrtype;    {receive header var}
  184.    rxtimeout,
  185.    rxtype,
  186.    rxframeind   : INTEGER;
  187.    attn         : buftype;
  188.    secbuf       : buftype;
  189.    fname        : STRING;
  190.    fmode        : INTEGER;
  191.    ftime,
  192.    fsize        : LONGINT;
  193.    send32crc    : BOOLEAN;  (* TRUE, wenn 32-Bit-CRC benutzt werden darf *)
  194.    zcps,
  195.    zerrors      : WORD;
  196.    txpos        : LONGINT;
  197.    txhdr        : hdrtype;
  198.    ztime        : LONGINT;
  199.  
  200.    zstartproc,
  201.    zdispproc    : POINTER;
  202.  
  203. CONST
  204.    lastsent: BYTE = 0;
  205.  
  206.  
  207. (*************************************************************************)
  208.  
  209. (* Schnelles Aufrufen einer Procedure auf die der POINTER <proc> zeigt *)
  210.  
  211. PROCEDURE CallUserProcedure (proc : POINTER);
  212.  
  213. BEGIN
  214.   InLine ($FF/$5E/< proc);
  215. END;
  216.  
  217.  
  218. (*************************************************************************)
  219.  
  220. (* Dem Modem die Empfangsbereitschaft anzeigen. *)
  221. (* Dies geschiet durch Setzen der RTS-Leitung.  *)
  222.  
  223. Procedure ModemRun (kanal : WORD);
  224.  
  225. BEGIN
  226.   RequestToSend (kanal,On);
  227. END; (* of ModemRun *)
  228.  
  229.  
  230. (*************************************************************************)
  231.  
  232. (* Dem Modem anzeigen, dass zur zeit keine Zeichen verarbeitet.    *)
  233. (* werden können. Diese geschiet durch Rücksetzen der RTS-Leitung. *)
  234.  
  235. Procedure ModemStop (kanal : WORD);
  236.  
  237. BEGIN
  238.   RequestToSend (kanal,Off);
  239. END; (* of ModemStop *)
  240.  
  241.  
  242. (*************************************************************************)
  243.  
  244. (* Berechnen der CRC-Summe eines Files *)
  245.  
  246. FUNCTION Z_FileCRC32 (VAR f: FILE): LONGINT;
  247.  
  248. VAR
  249.    fbuf  : buftype;
  250.  
  251.    crc   : LONGINT;
  252.  
  253.    n,
  254.    bread : INTEGER;
  255.  
  256. BEGIN
  257.    crc := $FFFFFFFF;
  258.    Seek(f,0);
  259.    IF (IOresult <> 0) THEN
  260.       {null};
  261.    REPEAT
  262.       BlockRead(f,fbuf,ZBUFSIZE,bread);
  263.       FOR n := 0 TO (bread - 1) DO crc := UpdC32 (fbuf [n],crc)
  264.    UNTIL (bread < ZBUFSIZE) OR (IOresult <> 0);
  265.    Seek(f,0);
  266.    IF (IOresult <> 0) THEN
  267.       {null};
  268.    Z_FileCRC32 := crc
  269. END;
  270.  
  271.  
  272. (*************************************************************************)
  273.  
  274. FUNCTION Z_GetByte (tenths : INTEGER) : INTEGER;
  275.  
  276. (* Reads a byte from the modem - Returns RCDO if *)
  277. (* no carrier, or ZTIMEOUT if nothing received   *)
  278. (* within 'tenths' of a second.                  *)
  279.  
  280.   VAR
  281.     c    : INTEGER;
  282.  
  283.     time : LONGINT;
  284.  
  285. BEGIN
  286.   IF ReceiverReady (modemkanal) THEN BEGIN
  287.     c := ORD (SeriellRead (modemkanal));
  288.     {$IFDEF TPZLog}
  289.        Write (tpzlog,CHAR (c));
  290.     {$ENDIF}
  291.     Z_GetByte:=c;
  292.   END  (* of IF THEN *)
  293.   ELSE BEGIN
  294.     time:=TimeCounter + tenths;
  295.     REPEAT
  296.       IF NOT (CarrierDetector (modemkanal)) THEN BEGIN
  297.          Z_GetByte := RCDO; { nobody to talk to }
  298.          Exit;
  299.       END  (* of IF THEN *)
  300.       ELSE IF ReceiverReady (modemkanal) THEN BEGIN
  301.          c := ORD (SeriellRead (modemkanal));
  302.          {$IFDEF TPZLog}
  303.            Write (tpzlog,CHAR (c));
  304.          {$ENDIF}
  305.          Z_GetByte:=c;
  306.          Exit;
  307.       END;
  308.  
  309.     UNTIL (TimeCounter > time);
  310.  
  311.     Z_GetByte := ZTIMEOUT        { timed out }
  312.   END;  (* of ELSE *)
  313. END;
  314.  
  315.  
  316. (*************************************************************************)
  317.  
  318. FUNCTION Z_qk_read : INTEGER;
  319.  
  320. (* Just like Z_GetByte, but timeout value is in *)
  321. (* global var rxtimeout.                        *)
  322.  
  323.   VAR
  324.     stop : BOOLEAN;
  325.  
  326.     ch   : CHAR;
  327.  
  328.     c    : INTEGER;
  329.  
  330.     time : LONGINT;
  331.  
  332. BEGIN
  333.   IF ReceiverReady (modemkanal) THEN BEGIN
  334.     c:=ORD (SeriellRead (modemkanal));
  335.     {$IFDEF TPZLog}
  336.       Write (tpzlog,CHAR (c));
  337.     {$ENDIF}
  338.     Z_qk_read:=c;
  339.   END  (* of IF THEN *)
  340.   ELSE BEGIN
  341.     time:=TimeCounter + rxtimeout;
  342.     stop:=FALSE;
  343.     REPEAT
  344.       IF ReceiverReady (modemkanal) THEN BEGIN
  345.         ch:=SeriellRead (modemkanal);
  346.         {$IFDEF TPZLog}
  347.           Write (tpzlog,ch);
  348.         {$ENDIF}
  349.         stop:=TRUE;
  350.       END;  (* of IF *)
  351.     UNTIL stop OR (TimeCounter > time) OR NOT (CarrierDetector (modemkanal));
  352.  
  353.     IF (TimeCounter > time) THEN
  354.       c:=ZTIMEOUT
  355.     ELSE IF NOT (CarrierDetector (modemkanal)) THEN
  356.       c:=RCDO
  357.     ELSE c:=ORD (ch);
  358.     Z_qk_read := c;
  359.   END;  (* of ELSE *)
  360. END;
  361.  
  362. (*************************************************************************)
  363.  
  364. FUNCTION Z_TimedRead : INTEGER;
  365.  
  366. (* A Z_qk_read, that strips parity and *)
  367. (* ignores XON/XOFF characters.        *)
  368.  
  369. VAR
  370.    stop : BOOLEAN;
  371.  
  372.    ch   : CHAR;
  373.  
  374.    c    : INTEGER;
  375.  
  376.    time : LONGINT;
  377.  
  378. BEGIN
  379.    time:=TimeCounter + rxtimeout;
  380.    stop:=FALSE;
  381.    REPEAT
  382.      IF ReceiverReady (modemkanal) THEN BEGIN
  383.        ch:=SeriellRead (modemkanal);
  384.        {$IFDEF TPZLog}
  385.          Write (tpzlog,ch);
  386.        {$ENDIF}
  387.        IF (ch <> CHR (XON)) AND (ch <> CHR (XOFF)) THEN stop:=TRUE;
  388.      END;  (* of IF *)
  389.    UNTIL stop OR (TimeCounter > time) OR NOT (CarrierDetector (modemkanal));
  390.  
  391.    IF (TimeCounter > time) THEN
  392.      c:=ZTIMEOUT
  393.    ELSE IF NOT (CarrierDetector (modemkanal)) THEN
  394.      c:=RCDO
  395.    ELSE c:=ORD (ch);
  396.    Z_TimedRead := c
  397. END;
  398.  
  399.  
  400. (*************************************************************************)
  401.  
  402. (* Senden des Zeichen in <c>.                  *)
  403. (* Es wird gewartet, bis das Modem bereit ist. *)
  404.  
  405. PROCEDURE Z_SendByte (c : INTEGER);
  406.  
  407.   VAR
  408.     time : LONGINT;
  409.  
  410. BEGIN
  411.   IF NOT (SeriellStatus (modemkanal)) THEN BEGIN
  412.     time:=TimeCounter + txtimeout;
  413.     REPEAT
  414.     UNTIL SeriellStatus (modemkanal) OR (TimeCounter > time);
  415.   END;  (* of IF *)
  416.  
  417.   SeriellWrite (modemkanal,CHAR (c));
  418. END;  (* of Z_SendByte *)
  419.  
  420.  
  421. (*************************************************************************)
  422.  
  423. PROCEDURE Z_SendCan;
  424.  
  425. (* Send a zmodem CANcel sequence to the other guy *)
  426. (* 8 CANs and 8 backspaces                        *)
  427.  
  428.   VAR
  429.     n: BYTE;
  430.  
  431. BEGIN
  432.   ClearSeriellBuffer (modemkanal);
  433.   FOR n := 1 TO 8 DO BEGIN
  434.     Z_SendByte (CAN);
  435.     Delay (100)        { the pause seems to make reception of the sequence }
  436.   END;                 { more reliable                                     }
  437.  
  438.   FOR n := 1 TO 10 DO Z_SendByte (8)
  439. END;
  440.  
  441.  
  442. (*************************************************************************)
  443.  
  444. PROCEDURE Z_PutString (VAR p: buftype);
  445.  
  446. (* Outputs an ASCII-Z type string (null terminated) *)
  447. (* Processes meta characters 221 (send break) and   *)
  448. (* 222 (2 second delay).                            *)
  449.  
  450.   VAR
  451.     n : WORD;
  452.  
  453. BEGIN
  454.   n := 0;
  455.   WHILE (n < ZBUFSIZE) AND (p [n] <> 0) DO BEGIN
  456.     CASE p [n] OF
  457.        221 : SendBreak (modemkanal);
  458.        222 : Delay (2000)
  459.       ELSE   Z_SendByte (p [n])
  460.     END;
  461.     INC (n)
  462.   END;  (* of WHILE *)
  463. END;  (* of Z_PutString *)
  464.  
  465.  
  466. (*************************************************************************)
  467.  
  468. PROCEDURE Z_PutHex (b: BYTE);
  469.  
  470. (* Output a byte as two hex digits (in ASCII) *)
  471. (* Uses lower case to avoid confusion with    *)
  472. (* escaped control characters.                *)
  473.  
  474. CONST
  475.    hex: ARRAY[0..15] OF CHAR = '0123456789abcdef';
  476.  
  477. BEGIN
  478.    Z_SendByte (ORD (hex[b SHR 4]));  { high nybble }
  479.    Z_SendByte (ORD (hex[b AND $0F])) { low nybble  }
  480. END;
  481.  
  482. (*************************************************************************)
  483.  
  484. PROCEDURE Z_SendHexHeader (htype : BYTE ; VAR hdr : hdrtype);
  485.  
  486. (* Sends a zmodem hex type header *)
  487.  
  488. VAR
  489.    crc : WORD;
  490.    n,
  491.    i   : INTEGER;
  492.  
  493. BEGIN
  494.    Z_SendByte (ZPAD);                  { '*' }
  495.    Z_SendByte (ZPAD);                  { '*' }
  496.    Z_SendByte (ZDLE);                  { 24  }
  497.    Z_SendByte (ZHEX);                  { 'B' }
  498.    Z_PutHex (htype);
  499.  
  500.    crc := UpdCrc(htype,0);
  501.  
  502.    FOR n := 0 TO 3 DO BEGIN
  503.       Z_PutHex (hdr [n]);
  504.       crc := UpdCrc (hdr [n],crc)
  505.    END;
  506.  
  507.    crc := UpdCrc (0,crc);
  508.    crc := UpdCrc (0,crc);
  509.  
  510.    Z_PutHex (Lo (crc SHR 8));
  511.    Z_PutHex (Lo (crc));
  512.  
  513.    Z_SendByte (13);                    { make it readable to the other end }
  514.    Z_SendByte (10);                    { just in case                      }
  515.  
  516.    IF (htype <> ZFIN) AND (htype <> ZACK) THEN
  517.       Z_SendByte (17);                 { Prophylactic XON to assure flow   }
  518.  
  519. END;
  520.  
  521.  
  522. (*************************************************************************)
  523.  
  524. FUNCTION Z_PullLongFromHeader (VAR hdr : hdrtype) : LONGINT;
  525.  
  526.   TYPE
  527.     longarray = ARRAY [0..3] OF BYTE;
  528.  
  529.   VAR
  530.     l       : LONGINT;
  531.  
  532.     longptr : longarray ABSOLUTE l;
  533.  
  534. BEGIN
  535.    longptr [0]:=hdr [ZP0];
  536.    longptr [1]:=hdr [ZP1];
  537.    longptr [2]:=hdr [ZP2];
  538.    longptr [3]:=hdr [ZP3];
  539.  
  540.    Z_PullLongFromHeader := l
  541. END;
  542.  
  543.  
  544. (*************************************************************************)
  545.  
  546. PROCEDURE Z_PutLongIntoHeader (l : LONGINT);
  547.  
  548.   TYPE
  549.     longarray = ARRAY [0..3] OF BYTE;
  550.  
  551.   VAR
  552.     longptr : longarray ABSOLUTE l;
  553.  
  554. BEGIN
  555.   txhdr [ZP0]:=longptr [0];
  556.   txhdr [ZP1]:=longptr [1];
  557.   txhdr [ZP2]:=longptr [2];
  558.   txhdr [ZP3]:=longptr [3];
  559. END;
  560.  
  561.  
  562. (*************************************************************************)
  563.  
  564. FUNCTION Z_GetZDL : INTEGER;
  565.  
  566. (* Gets a byte and processes for ZMODEM escaping or CANcel sequence *)
  567.  
  568.   VAR
  569.      c,
  570.      d  : INTEGER;
  571.  
  572. BEGIN
  573.    c := Z_qk_read;
  574.    IF (c <> ZDLE) THEN BEGIN
  575.      Z_GetZDL := c;
  576.    END                                        {got ZDLE or 1st CAN}
  577.    ELSE BEGIN
  578.      c := Z_qk_read;
  579.      IF (c = CAN) THEN BEGIN                  {got 2nd CAN}
  580.        c := Z_qk_read;
  581.        IF (c = CAN) THEN BEGIN                {got 3rd CAN}
  582.          c := Z_qk_read;
  583.          IF (c = CAN) THEN c := Z_qk_read;    {got 4th CAN}
  584.        END;  (* of IF *)
  585.      END;  (* of IF *)
  586.                                               { Flags set in high byte }
  587.      CASE c OF
  588.           CAN : Z_GetZDL := GOTCAN;           {got 5th CAN}
  589.         ZCRCE,                                {got a frame end marker}
  590.         ZCRCG,
  591.         ZCRCQ,
  592.         ZCRCW : Z_GetZDL := (c OR GOTOR);
  593.         ZRUB0 : Z_GetZDL := $007F;            {got an ASCII DELete}
  594.         ZRUB1 : Z_GetZDL := $00FF             {any parity         }
  595.         ELSE BEGIN
  596.            IF (c < 0) THEN
  597.               Z_GetZDL := c
  598.            ELSE IF ((c AND $60) = $40) THEN   {make sure it was a valid escape}
  599.               Z_GetZDL := c XOR $40
  600.            ELSE Z_GetZDL := ZERROR
  601.         END;  (* of ELSE *)
  602.      END;  (* of CASE *)
  603.    END;  (* of ELSE *)
  604. END;
  605.  
  606.  
  607. (*************************************************************************)
  608.  
  609. FUNCTION Z_GetHex: INTEGER;
  610. (* Get a byte that has been received as two ASCII hex digits *)
  611. VAR
  612.    c, n: INTEGER;
  613.  
  614. BEGIN
  615.    n := Z_TimedRead;
  616.    IF (n < 0) THEN BEGIN
  617.       Z_GetHex := n;
  618.       Exit
  619.    END;
  620.    n := n - $30;                     {build the high nybble}
  621.    IF (n > 9) THEN n := n - 39;
  622.    IF (n AND $FFF0 <> 0) THEN BEGIN
  623.       Z_GetHex := ZERROR;
  624.       Exit
  625.    END;
  626.    c := Z_TimedRead;
  627.    IF (c < 0) THEN BEGIN
  628.       Z_GetHex := c;
  629.       Exit
  630.    END;
  631.    c := c - $30;                     {now the low nybble}
  632.    IF (c > 9) THEN c := c - 39;
  633.    IF (c AND $FFF0 <> 0) THEN BEGIN
  634.       Z_GetHex := ZERROR;
  635.       Exit
  636.    END;
  637.    Z_GetHex := (n SHL 4) OR c        {Insert tab 'A' in slot 'B'...}
  638. END;
  639.  
  640.  
  641. (*************************************************************************)
  642.  
  643. FUNCTION Z_GetHexHeader(VAR hdr: hdrtype): INTEGER;
  644.  
  645. (* Receives a zmodem hex type header *)
  646.  
  647.   VAR
  648.     crc : WORD;
  649.     c,
  650.     n   : INTEGER;
  651.  
  652. BEGIN
  653.    c := Z_GetHex;
  654.    IF (c < 0) THEN BEGIN
  655.       Z_GetHexHeader := c;
  656.       Exit
  657.    END;
  658.  
  659.    rxtype := c;                        {get the type of header}
  660.    crc := UpdCrc (rxtype,0);
  661.  
  662.    FOR n := 0 To 3 DO BEGIN            {get the 4 bytes}
  663.       c := Z_GetHex;
  664.       IF (c < 0) THEN BEGIN
  665.          Z_GetHexHeader := c;
  666.          Exit
  667.       END;
  668.       hdr[n] := Lo (c);
  669.       crc := UpdCrc (Lo (c),crc)
  670.    END;
  671.  
  672.    c := Z_GetHex;
  673.    IF (c < 0) THEN BEGIN
  674.       Z_GetHexHeader := c;
  675.       Exit
  676.    END;
  677.    crc := UpdCrc (Lo (c),crc);
  678.  
  679.    c := Z_GetHex;
  680.    IF (c < 0) THEN BEGIN
  681.       Z_GetHexHeader := c;
  682.       Exit
  683.    END;
  684.    crc := UpdCrc (Lo (c),crc);             {check the CRC}
  685.  
  686.    IF (crc <> 0) THEN BEGIN
  687.       INC (TransferError);
  688.       Z_GetHexHeader := ZERROR;
  689.       Exit
  690.    END;
  691.  
  692.    IF (Z_GetByte (2) = 13) THEN           {throw away CR/LF}
  693.       c := Z_GetByte (2);
  694.    Z_GetHexHeader := rxtype
  695. END;
  696.  
  697.  
  698. (*************************************************************************)
  699.  
  700. FUNCTION Z_GetBinaryHeader (VAR hdr: hdrtype) : INTEGER;
  701.  
  702. (* Same as above, but binary with 16 bit CRC *)
  703.  
  704. VAR
  705.    crc : WORD;
  706.    c,
  707.    n   : INTEGER;
  708.  
  709. BEGIN
  710.    c := Z_GetZDL;
  711.    IF (c < 0) THEN BEGIN
  712.       Z_GetBinaryHeader := c;
  713.       Exit
  714.    END;
  715.  
  716.    rxtype := c;
  717.    crc := UpdCrc (rxtype,0);
  718.  
  719.    FOR n := 0 To 3 DO BEGIN
  720.       c := Z_GetZDL;
  721.       IF (Hi(c) <> 0) THEN BEGIN
  722.          Z_GetBinaryHeader := c;
  723.          Exit
  724.       END;
  725.       hdr[n] := Lo (c);
  726.       crc := UpdCrc (Lo (c),crc)
  727.    END;
  728.  
  729.    c := Z_GetZDL;
  730.    IF (Hi (c) <> 0) THEN BEGIN
  731.       Z_GetBinaryHeader := c;
  732.       Exit
  733.    END;
  734.    crc := UpdCrc(Lo(c),crc);
  735.  
  736.    c := Z_GetZDL;
  737.    IF (Hi(c) <> 0) THEN BEGIN
  738.       Z_GetBinaryHeader := c;
  739.       Exit
  740.    END;
  741.    crc := UpdCrc(Lo(c),crc);
  742.  
  743.    IF (crc <> 0) THEN BEGIN
  744.       INC (TransferError);
  745.       Exit
  746.    END;
  747.    Z_GetBinaryHeader := rxtype
  748. END;
  749.  
  750.  
  751. (*************************************************************************)
  752.  
  753. FUNCTION Z_GetBinaryHead32(VAR hdr: hdrtype): INTEGER;
  754. (* Same as above but with 32 bit CRC *)
  755. VAR
  756.    crc: LONGINT;
  757.    c, n: INTEGER;
  758. BEGIN
  759.    c := Z_GetZDL;
  760.    IF (c < 0) THEN BEGIN
  761.       Z_GetBinaryHead32 := c;
  762.       Exit
  763.    END;
  764.  
  765.    rxtype := c;
  766.    crc := UpdC32 (rxtype,$FFFFFFFF);
  767.  
  768.    FOR n := 0 To 3 DO BEGIN
  769.       c := Z_GetZDL;
  770.       IF (Hi (c) <> 0) THEN BEGIN
  771.          Z_GetBinaryHead32 := c;
  772.          Exit
  773.       END;
  774.       hdr[n] := Lo (c);
  775.       crc := UpdC32 (Lo (c),crc)
  776.    END;
  777.  
  778.    FOR n := 0 To 3 DO BEGIN
  779.       c := Z_GetZDL;
  780.       IF (Hi (c) <> 0) THEN BEGIN
  781.          Z_GetBinaryHead32 := c;
  782.          Exit
  783.       END;
  784.       crc := UpdC32 (Lo (c),crc)
  785.    END;
  786.  
  787.    IF (crc <> $DEBB20E3) THEN BEGIN   {this is the polynomial value}
  788.       INC (TransferError);
  789.       Z_GetBinaryHead32 := ZERROR;
  790.       Exit
  791.    END;
  792.  
  793.    Z_GetBinaryHead32 := rxtype
  794. END;
  795.  
  796.  
  797. (*************************************************************************)
  798.  
  799. FUNCTION Z_GetHeader (VAR hdr: hdrtype): INTEGER;
  800.  
  801. (* Use this routine to get a header - it will figure out  *)
  802. (* what type it is getting (hex, bin16 or bin32) and call *)
  803. (* the appropriate routine.                               *)
  804.  
  805. LABEL
  806.    gotcan, again, agn2, splat, done;  {sorry, but it's actually eisier to}
  807.  
  808. VAR                                   {follow, and lots more efficient   }
  809.    c, n, cancount: INTEGER;           {this way...                       }
  810.  
  811. BEGIN
  812.    IF (zbaud > $3FFF) THEN
  813.      n:=$7FFF
  814.    ELSE n := zbaud * 2;               {A guess at the # of garbage characters}
  815.  
  816.    cancount:= 5;                      {to expect.                            }
  817.    send32crc:=FALSE;                  {assume 16 bit until proven otherwise  }
  818.  
  819. again:
  820.  
  821.    IF (KeyPressed) THEN BEGIN                       {check for operator panic}
  822.      IF (ReadKey = #27) THEN BEGIN                  {in the form of ESCape   }
  823.        Z_SendCan;                                   {tell the other end,     }
  824.        TransferMessage:='Cancelled from keyboard';  {the operator,           }
  825.        Z_GetHeader := ZCAN;                         {and the rest of the     }
  826.        Exit                                         {routines to forget it.  }
  827.      END;  (* of IF *)
  828.    END;  (* of IF *)
  829.  
  830.    rxframeind := 0;
  831.    rxtype := 0;
  832.    c := Z_TimedRead;
  833.  
  834.    CASE c OF
  835.           ZPAD : {we want this! - all headers begin with '*'.} ;
  836.           RCDO,
  837.       ZTIMEOUT : GOTO done;
  838.            CAN : BEGIN
  839. gotcan:
  840.                    DEC (cancount);
  841.                    IF (cancount < 0) THEN BEGIN
  842.                      c := ZCAN;
  843.                      GOTO done
  844.                    END;
  845.                    c := Z_GetByte (2);
  846.                    CASE c OF
  847.                      ZTIMEOUT : GOTO again;
  848.                         ZCRCW : BEGIN
  849.                                   c := ZERROR;
  850.                                   GOTO done
  851.                                 END;
  852.                          RCDO : GOTO done;
  853.                           CAN : BEGIN
  854.                                   DEC (cancount);
  855.                                   IF (cancount < 0) THEN BEGIN
  856.                                     c := ZCAN;
  857.                                     GOTO done
  858.                                   END;
  859.                                   GOTO again
  860.                                 END
  861.                          ELSE   {fallthru}
  862.               END {case}
  863.            END {can}
  864.       ELSE
  865. agn2: BEGIN
  866.          DEC (n);
  867.          IF (n < 0) THEN BEGIN
  868.             INC (TransferError);
  869.             TransferMessage:='Header is FUBAR';
  870.             Z_GetHeader := ZERROR;
  871.             Exit
  872.          END;
  873.  
  874.          IF (c <> CAN) THEN cancount := 5;
  875.  
  876.          GOTO again
  877.       END
  878.    END;           {only falls thru if ZPAD - anything else is trash}
  879.    cancount := 5;
  880. splat:
  881.    c := Z_TimedRead;
  882.    CASE c OF
  883.           ZDLE : {this is what we want!} ;
  884.           ZPAD : GOTO splat;   {junk or second '*' of a hex header}
  885.           RCDO,
  886.       ZTIMEOUT : GOTO done
  887.           ELSE   GOTO agn2
  888.    END; {only falls thru if ZDLE}
  889.    c := Z_TimedRead;
  890.  
  891.    CASE c OF
  892.        ZBIN32 : BEGIN
  893.                   rxframeind := ZBIN32;          {using 32 bit CRC}
  894.                   c := Z_GetBinaryHead32 (hdr)
  895.                 END;
  896.          ZBIN : BEGIN
  897.                   rxframeind := ZBIN;            {bin with 16 bit CRC}
  898.                   c := Z_GetBinaryHeader (hdr)
  899.                 END;
  900.          ZHEX : BEGIN
  901.                   rxframeind := ZHEX;            {hex}
  902.                   c := Z_GetHexHeader (hdr)
  903.                 END;
  904.           CAN : GOTO gotcan;
  905.          RCDO,
  906.      ZTIMEOUT : GOTO done
  907.          ELSE   GOTO agn2
  908.    END; {only falls thru if we got ZBIN, ZBIN32 or ZHEX}
  909.  
  910.    rxpos := Z_PullLongFromHeader (hdr);       {set rxpos just in case this}
  911. done:                                         {header has file position   }
  912.    Z_GetHeader := c                           {info (i.e.: ZRPOS, etc.   )}
  913. END;
  914.  
  915.  
  916. (***************************************************)
  917. (* RECEIVE FILE ROUTINES                           *)
  918. (***************************************************)
  919.  
  920. CONST
  921.    ZATTNLEN = 32;  {max length of attention string}
  922.    lastwritten: BYTE = 0;
  923.  
  924. VAR
  925.    t           : LONGINT;
  926.    rzbatch     : BOOLEAN;
  927.    outfile     : FILE;     {this is the file}
  928.    tryzhdrtype : BYTE;
  929.    rxcount     : INTEGER;
  930.    filestart   : LONGINT;
  931.    isbinary,
  932.    eofseen     : BOOLEAN;
  933.    zconv       : BYTE;
  934.    zrxpath     : STRING;
  935.  
  936.  
  937. (*************************************************************************)
  938.  
  939. (* Empfangen von Datenblöcken mit 16 o. 32-Bit-CRC *)
  940.  
  941. FUNCTION RZ_ReceiveData (VAR buf : buftype ; blength : INTEGER) : INTEGER;
  942.  
  943.   LABEL
  944.     crcfoo;
  945.  
  946.   VAR
  947.     c,
  948.     d          : INTEGER;
  949.  
  950.     n,
  951.     crc        : WORD;
  952.  
  953.     crc32      : LONGINT;
  954.  
  955.     done,
  956.     badcrc,
  957.     uses32crc  : boolean;
  958.  
  959. BEGIN
  960.    IF (rxframeind = ZBIN32) THEN BEGIN
  961.      crc32:=$FFFFFFFF;
  962.      uses32crc:=TRUE;
  963.      TransferCheck:='CRC-32';
  964.    END  (* of IF THEN *)
  965.    ELSE BEGIN
  966.      crc:=0;
  967.      uses32crc:=FALSE;
  968.      TransferCheck:='CRC-16';
  969.    END;  (* of ELSE *)
  970.  
  971.    rxcount := 0;
  972.    done:=FALSE;
  973.  
  974.    REPEAT
  975.       c := Z_GetZDL;
  976.  
  977.       IF (Hi (c) <> 0) THEN BEGIN
  978.          IF KeyPressed THEN BEGIN
  979.            IF (ReadKey = #27) THEN BEGIN
  980.              Z_SendCan;
  981.              TransferMessage:='Cancelled from keyboard';
  982.              RZ_ReceiveData := ZCAN;
  983.              Exit;
  984.            END;  (* of IF *)
  985.          END;  (* of IF *)
  986.  
  987.          done:=TRUE;
  988. crcfoo:
  989.          CASE c OF
  990.             GOTCRCE,
  991.             GOTCRCG,
  992.             GOTCRCQ,
  993.             GOTCRCW: BEGIN
  994.                         d:=c;
  995.                         IF uses32crc THEN BEGIN
  996.                           crc32:=UpdC32 (Lo (c),crc32);
  997.                           FOR n:=0 TO 3 DO BEGIN
  998.                             c := Z_GetZDL;
  999.                             IF (Hi (c) <> 0) THEN GOTO crcfoo;
  1000.                             crc32:=UpdC32 (Lo (c),crc32)
  1001.                           END;
  1002.                           badcrc:=(crc32 <> $DEBB20E3);
  1003.                         END  (* of IF THEN *)
  1004.                         ELSE BEGIN
  1005.                           crc := UpdCrc (Lo (c),crc);
  1006.                           c:=Z_GetZDL;
  1007.                           IF (Hi (c) <> 0) THEN GOTO crcfoo;
  1008.                           crc := UpdCrc (Lo (c),crc);
  1009.                           c:=Z_GetZDL;
  1010.                           IF (Hi (c) <> 0) THEN GOTO crcfoo;
  1011.                           crc := UpdCrc (Lo (c),crc);
  1012.  
  1013.                           badcrc:=(crc <> 0);
  1014.                         END;  (* of ELSE *)
  1015.  
  1016.                         IF badcrc THEN BEGIN
  1017.                           INC (TransferError);
  1018.                           RZ_ReceiveData := ZERROR;
  1019.                         END  (* of IF THEN *)
  1020.                         ELSE RZ_ReceiveData := d;
  1021.                      END;
  1022.             GOTCAN : BEGIN
  1023.                        TransferMessage:='Got CANned';
  1024.                        RZ_ReceiveData := ZCAN;
  1025.                      END;
  1026.           ZTIMEOUT : BEGIN
  1027.                        TransferMessage:='Timeout';
  1028.                        RZ_ReceiveData := c;
  1029.                      END;
  1030.               RCDO : BEGIN
  1031.                        TransferMessage:='Lost carrier';
  1032.                        RZ_ReceiveData := c;
  1033.                      END
  1034.               ELSE   BEGIN
  1035.                        TransferMessage:='Debris';
  1036.                        ClearSeriellBuffer (modemkanal);
  1037.                        RZ_ReceiveData := c;
  1038.                      END
  1039.          END;  (* of CASE *)
  1040.       END  (* of IF THEN *)
  1041.       ELSE BEGIN
  1042.          DEC (blength);
  1043.          IF (blength < 0) THEN BEGIN
  1044.            TransferMessage:='Long packet';
  1045.            RZ_ReceiveData := ZERROR;
  1046.            done:=TRUE;
  1047.          END  (* of IF THEN *)
  1048.          ELSE BEGIN
  1049.            buf [INTEGER (rxcount)]:=Lo (c);
  1050.            INC (rxcount);
  1051.            IF uses32crc THEN
  1052.              crc32:= UpdC32 (Lo (c),crc32)
  1053.            ELSE crc := UpdCrc (Lo (c),crc);
  1054.          END;  (* of ELSE *)
  1055.       END;  (* of ELSE *)
  1056.    UNTIL done;
  1057. END;
  1058.  
  1059.  
  1060. (*************************************************************************)
  1061.  
  1062. PROCEDURE RZ_AckBibi;
  1063.  
  1064. (* ACKnowledge the other ends request to terminate cleanly *)
  1065.  
  1066.   VAR
  1067.     n : INTEGER;
  1068.  
  1069. BEGIN
  1070.    Z_PutLongIntoHeader (rxpos);
  1071.    n := 4;
  1072.    ClearSeriellBuffer (modemkanal);
  1073.    REPEAT
  1074.       Z_SendHexHeader (ZFIN,txhdr);
  1075.       CASE Z_GetByte (2) OF
  1076.          ZTIMEOUT,
  1077.              RCDO : Exit;
  1078.                79 : BEGIN
  1079.                       ClearSeriellBuffer (modemkanal);
  1080.                       n:=0;
  1081.                     END
  1082.              ELSE   BEGIN
  1083.                       ClearSeriellBuffer (modemkanal);
  1084.                       DEC (n)
  1085.                     END;
  1086.       END;  (* of CASE *)
  1087.    UNTIL (n <= 0);
  1088. END;
  1089.  
  1090.  
  1091. (*************************************************************************)
  1092.  
  1093. FUNCTION RZ_InitReceiver: INTEGER;
  1094.  
  1095.   VAR
  1096.      c,
  1097.      n,
  1098.      errors : INTEGER;
  1099.  
  1100.      stop,
  1101.      again  : BOOLEAN;
  1102.  
  1103. BEGIN
  1104.    FillChar (attn,SizeOf (attn),0);
  1105.  
  1106.    n:=10;
  1107.    stop:=FALSE;
  1108.  
  1109.    WHILE (n > 0) AND NOT (stop) DO BEGIN
  1110.      IF NOT (CarrierDetector (modemkanal)) THEN BEGIN
  1111.        TransferMessage:='Lost carrier';
  1112.        RZ_InitReceiver := ZERROR;
  1113.        Exit
  1114.      END;
  1115.  
  1116.      Z_PutLongIntoHeader (LONGINT (0));
  1117.  
  1118.      txhdr [ZF0]:=CANFDX OR CANOVIO OR CANBRK;         (* Full dplx, overlay I/O *)
  1119.      IF MakeCRC32 THEN BEGIN                           (* 32-Bit-CRC zulassen    *)
  1120.        txhdr [ZF0]:=txhdr [ZF0] OR CANFC32;
  1121.      END;  (* of IF *)
  1122.  
  1123.      Z_SendHexHeader (tryzhdrtype,txhdr);
  1124.  
  1125.      IF (tryzhdrtype = ZSKIP) THEN
  1126.         tryzhdrtype := ZRINIT;
  1127.  
  1128.         again:=FALSE;
  1129.         REPEAT
  1130.           c := Z_GetHeader (rxhdr);
  1131.           CASE c OF
  1132.              ZFILE : BEGIN
  1133.                        zconv:=rxhdr [ZF0];
  1134.                        tryzhdrtype:=ZRINIT;
  1135.  
  1136.                        c := RZ_ReceiveData (secbuf,ZBUFSIZE);
  1137.  
  1138.                        IF (c = GOTCRCW) THEN BEGIN
  1139.                          RZ_InitReceiver := ZFILE;
  1140.                          stop:=TRUE;
  1141.                        END  (* of IF THEN *)
  1142.                        ELSE BEGIN
  1143.                          Z_SendHexHeader (ZNAK,txhdr);
  1144.                          again:=TRUE;
  1145.                        END;  (* of ELSE *)
  1146.                      END;
  1147.             ZSINIT : BEGIN
  1148.                        c := RZ_ReceiveData (attn,ZBUFSIZE);
  1149.                        IF (c = GOTCRCW) THEN
  1150.                            Z_SendHexHeader (ZACK,txhdr)
  1151.                        ELSE Z_SendHexHeader (ZNAK,txhdr);
  1152.                        again:=TRUE;
  1153.                      END;
  1154.           ZFREECNT : BEGIN
  1155.                        Z_PutLongIntoHeader (DiskFree (0));
  1156.                        Z_SendHexHeader (ZACK,txhdr);
  1157.                        again:=TRUE;
  1158.                     END;
  1159.          ZCOMMAND : BEGIN
  1160.                        c := RZ_ReceiveData (secbuf,ZBUFSIZE);
  1161.                        IF (c = GOTCRCW) THEN BEGIN
  1162.                           Z_PutLongIntoHeader (LONGINT (0));
  1163.                           errors:=0;
  1164.                           REPEAT
  1165.                              Z_SendHexHeader (ZCOMPL,txhdr);
  1166.                              INC (errors)
  1167.                           UNTIL (errors > 10) OR (Z_GetHeader(rxhdr) = ZFIN);
  1168.                           RZ_AckBibi;
  1169.                           RZ_InitReceiver := ZCOMPL;
  1170.                           stop:=TRUE;
  1171.                        END  (* of IF THEN *)
  1172.                        ELSE BEGIN
  1173.                          Z_SendHexHeader (ZNAK,txhdr);
  1174.                          again:=TRUE;
  1175.                        END;  (* of ELSE *)
  1176.                     END;
  1177.            ZCOMPL,
  1178.              ZFIN : BEGIN
  1179.                       RZ_InitReceiver := ZCOMPL;
  1180.                       stop:=TRUE;
  1181.                     END;
  1182.              ZCAN,
  1183.              RCDO : BEGIN
  1184.                       RZ_InitReceiver := c;
  1185.                       stop:=TRUE;
  1186.                     END
  1187.        END;  (* of CASE *)
  1188.      UNTIL NOT (again) OR stop;
  1189.  
  1190.      DEC (n);
  1191.    END;  (* of WHILE *)
  1192.  
  1193.    IF NOT (stop) THEN BEGIN
  1194.      TransferMessage:='Timeout';
  1195.      RZ_InitReceiver := ZERROR;
  1196.    END;  (* of IF *)
  1197. END;
  1198.  
  1199.  
  1200. (*************************************************************************)
  1201.  
  1202. FUNCTION RZ_GetHeader: INTEGER;
  1203.  
  1204.   VAR
  1205.     returncode,
  1206.     e,
  1207.     p,
  1208.     n,
  1209.     i          : INTEGER;
  1210.  
  1211.     makefile   : BOOLEAN;
  1212.  
  1213.     multiplier : LONGINT;
  1214.  
  1215.     s,
  1216.     tname      : STRING;
  1217.  
  1218.     ttime,
  1219.     tsize      : LONGINT;
  1220.  
  1221. BEGIN
  1222.    isbinary := TRUE;    {Force the issue!}
  1223.  
  1224.    p := 0;
  1225.    s := '';
  1226.    WHILE (p < 255) AND (secbuf [p] <> 0) DO BEGIN
  1227.      s := s + UpCase (Chr (secbuf [p]));
  1228.      INC (p)
  1229.    END;
  1230.    INC (p);
  1231.  
  1232.    (* get rid of drive & path specifiers *)
  1233.  
  1234.    WHILE (Pos (':',s) > 0) DO Delete (s,1,Pos (':',s));
  1235.    WHILE (Pos ('\',s) > 0) DO Delete (s,1,Pos ('\',s));
  1236.    fname := s;
  1237.  
  1238.    TransferName:=fname;
  1239.  
  1240. (**** done with name ****)
  1241.  
  1242.    fsize := LONGINT (0);
  1243.    WHILE (p < ZBUFSIZE) AND (secbuf[p] <> $20) AND (secbuf[p] <> 0) DO BEGIN
  1244.       fsize := (fsize *10) + Ord(secbuf[p]) - $30;
  1245.       INC (p)
  1246.    END;
  1247.    INC (p);
  1248.  
  1249.    TransferSize:=fsize;
  1250.  
  1251. (**** done with size ****)
  1252.  
  1253.    s := '';
  1254.    WHILE (p < ZBUFSIZE) AND (secbuf [p] IN [$30..$37]) DO BEGIN
  1255.       s := s + Chr (secbuf[p]);
  1256.       INC (p)
  1257.    END;
  1258.    INC (p);
  1259.    ftime := Z_FromUnixDate (s);
  1260.  
  1261. (**** done with time ****)
  1262.  
  1263.    TransferMessage:='receive data';
  1264.    returncode:=ZOK;
  1265.    makefile:=FALSE;
  1266.  
  1267.    IF RecoverAllow AND (Z_FindFile (zrxpath + fname,tname,tsize,ttime)) THEN BEGIN
  1268.       IF (ttime = ftime) THEN BEGIN
  1269.         IF (zconv = ZCRESUM) AND (fsize = tsize) THEN BEGIN
  1270.            TransferCount:=fsize;
  1271.            TransferMessage:='File is already complete';
  1272.            returncode := ZSKIP;
  1273.         END  (* of IF THEN *)
  1274.         ELSE IF (fsize > tsize) THEN BEGIN
  1275.            filestart:=tsize;
  1276.            TransferCount:=tsize;
  1277.  
  1278.            IF (NOT Z_OpenFile (outfile,zrxpath + fname)) THEN BEGIN
  1279.               TransferMessage:='Error opening ' + fname;
  1280.               returncode := ZERROR;
  1281.            END  (* of IF THEN *)
  1282.            ELSE BEGIN
  1283.              IF (NOT Z_SeekFile (outfile,tsize)) THEN BEGIN
  1284.                TransferMessage:='Error positioning file';
  1285.                returncode := ZERROR;
  1286.              END  (* of IF THEN *)
  1287.              ELSE FileAddition:=RecoverFile;
  1288.            END;  (* of ELSE *)
  1289.         END  (* of ELSE IF THEN *)
  1290.         ELSE BEGIN
  1291.           makefile:=TRUE;
  1292.           FileAddition:=ReplaceFile;
  1293.         END;  (* of ELSE *)
  1294.       END  (* of IF THEN *)
  1295.       ELSE BEGIN
  1296.         makefile:=TRUE;
  1297.         FileAddition:=ReplaceFile;
  1298.       END;  (* of ELSE *)
  1299.    END
  1300.    ELSE BEGIN
  1301.      makefile:=TRUE;
  1302.      FileAddition:=NewFile;
  1303.    END;  (* of ELSE *)
  1304.  
  1305.    IF makefile THEN BEGIN
  1306.      filestart:=0;
  1307.      TransferCount:=0;
  1308.      IF (NOT Z_MakeFile(outfile,zrxpath + fname)) THEN BEGIN
  1309.        TransferMessage:='Unable to create ' + fname;
  1310.        returncode := ZERROR;
  1311.      END;  (* of IF THEN *)
  1312.    END;  (* of IF *)
  1313.  
  1314.    RZ_GetHeader := returncode;
  1315. END;  (* of RZ_GetHeader *)
  1316.  
  1317.  
  1318. (*************************************************************************)
  1319.  
  1320. FUNCTION RZ_SaveToDisk (VAR rxbytes : LONGINT) : INTEGER;
  1321.  
  1322. BEGIN
  1323.    ModemStop (modemkanal);
  1324.    IF (NOT Z_WriteFile (outfile,secbuf,rxcount)) THEN BEGIN
  1325.      TransferMessage:='Disk write error';
  1326.      RZ_SaveToDisk := ZERROR
  1327.    END
  1328.    ELSE RZ_SaveToDisk := ZOK;
  1329.    ModemRun (modemkanal);
  1330.    INC (rxbytes,rxcount);
  1331. END;
  1332.  
  1333.  
  1334. (*************************************************************************)
  1335.  
  1336. FUNCTION RZ_ReceiveFile : INTEGER;
  1337.  
  1338.   LABEL
  1339.     err, nxthdr, moredata;
  1340.  
  1341.   VAR
  1342.     c,
  1343.     n       : INTEGER;
  1344.  
  1345.     rxbytes : LONGINT;
  1346.  
  1347.     sptr    : STRING;
  1348.  
  1349.     done    : BOOLEAN;
  1350.  
  1351.     numstr  : STRING [10];
  1352.  
  1353.  
  1354.   (***********************************************************************)
  1355.  
  1356.   FUNCTION SaveDataBlock : INTEGER;
  1357.  
  1358.     VAR
  1359.       c : INTEGER;
  1360.  
  1361.   BEGIN
  1362.     n := 10;
  1363.     c := RZ_SaveToDisk (rxbytes);
  1364.     TransferBytes:=rxbytes - TransferCount;
  1365.     SaveDataBlock:=c;
  1366.   END;  (* of SaveDataBlock *)
  1367.  
  1368.  
  1369.   (***********************************************************************)
  1370.  
  1371. BEGIN
  1372.    done := TRUE;
  1373.    eofseen := FALSE;
  1374.  
  1375.    c := RZ_GetHeader;
  1376.  
  1377.    IF (c <> ZOK) THEN BEGIN
  1378.      IF (c = ZSKIP) THEN tryzhdrtype := ZSKIP;
  1379.      RZ_ReceiveFile := c;
  1380.      IF (zstartproc <> NIL) THEN CallUserProcedure (zstartproc);
  1381.      Exit
  1382.    END;
  1383.  
  1384.    c := ZOK;
  1385.    n := 10;
  1386.    rxbytes := filestart;
  1387.    rxpos := filestart;
  1388.    ztime := TimeCounter DIV 18;
  1389.    zcps := 0;
  1390.  
  1391.    TransferCount:=rxbytes;
  1392.    TransferBytes:=0;
  1393.    TransferTotalTime:=(TransferSize - filestart) DIV (zbaud DIV 10);
  1394.    TransferMessage:='receive data';
  1395.  
  1396.    IF (zstartproc <> NIL) THEN CallUserProcedure (zstartproc);
  1397.  
  1398.    REPEAT
  1399.       Z_PutLongIntoHeader (rxbytes);
  1400.       Z_SendHexHeader (ZRPOS,txhdr);
  1401.  
  1402. nxthdr:
  1403.  
  1404.       c := Z_GetHeader (rxhdr);
  1405.  
  1406.       CASE c OF
  1407.          ZDATA: BEGIN
  1408.                    IF (rxpos <> rxbytes) THEN BEGIN
  1409.                      DEC (n);
  1410.                      INC (TransferError);
  1411.                      IF (n < 0) THEN GOTO err;
  1412.                      TransferMessage:='Bad position';
  1413.                      Z_PutString (attn)
  1414.                    END  (* of IF THEN *)
  1415.                    ELSE BEGIN
  1416. moredata:
  1417.                       IF (zdispproc <> NIL) THEN CallUserProcedure (zdispproc);
  1418.  
  1419.                       c := RZ_ReceiveData (secbuf,ZBUFSIZE);
  1420.                       TransferBlockSize:=rxcount;
  1421.  
  1422.                       CASE c OF
  1423.                              ZCAN,
  1424.                              RCDO : GOTO err;
  1425.                            ZERROR : BEGIN
  1426.                                       DEC (n);
  1427.                                       INC (TransferError);
  1428.                                       Str (TransferCount + TransferBytes,numstr);
  1429.                                       TransferMessage:=numstr + ' : Bad CRC';
  1430.                                       IF (n < 0) THEN GOTO err;
  1431.                                     END;
  1432.                          ZTIMEOUT : BEGIN
  1433.                                       DEC (n);
  1434.                                       INC (TransferError);
  1435.                                       Str (TransferCount + TransferBytes,numstr);
  1436.                                       TransferMessage:=numstr + ' : Timeout';
  1437.                                       IF (n < 0) THEN GOTO err
  1438.                                     END;
  1439.                           GOTCRCW : BEGIN
  1440.                                       c:=SaveDataBlock;
  1441.                                       IF (c <> 0) THEN Exit;
  1442.  
  1443.                                       Z_PutLongIntoHeader (rxbytes);
  1444.                                       Z_SendHexHeader (ZACK,txhdr);
  1445.  
  1446.                                       GOTO nxthdr;
  1447.                                     END;
  1448.                           GOTCRCQ : BEGIN
  1449.                                       c:=SaveDataBlock;
  1450.                                       IF (c <> 0) THEN Exit;
  1451.  
  1452.                                       Z_PutLongIntoHeader (rxbytes);
  1453.                                       Z_SendHexHeader (ZACK,txhdr);
  1454.  
  1455.                                       GOTO moredata;
  1456.                                     END;
  1457.                           GOTCRCG : BEGIN
  1458.                                       c:=SaveDataBlock;
  1459.                                       IF (c <> 0) THEN Exit;
  1460.  
  1461.                                       GOTO moredata;
  1462.                                     END;
  1463.                           GOTCRCE : BEGIN
  1464.                                       c:=SaveDataBlock;
  1465.                                       IF (c <> 0) THEN Exit;
  1466.  
  1467.                                       GOTO nxthdr;
  1468.                                     END;
  1469.                       END {case}
  1470.                    END;  (* of IF *)
  1471.                 END; {case of ZDATA}
  1472.          ZNAK,
  1473.          ZTIMEOUT: BEGIN
  1474.                      DEC (n);
  1475.                      IF (n < 0) THEN GOTO err;
  1476.                      TransferBytes:=rxbytes - TransferCount;
  1477.                    END;
  1478.            ZFILE : c := RZ_ReceiveData (secbuf,ZBUFSIZE);
  1479.             ZEOF : IF (rxpos = rxbytes) THEN BEGIN
  1480.                      RZ_ReceiveFile := c;
  1481.                      Exit
  1482.                    END
  1483.                    ELSE GOTO nxthdr;
  1484.           ZERROR : BEGIN
  1485.                      DEC (n);
  1486.                      IF (n < 0) THEN GOTO err;
  1487.                      TransferBytes:=rxbytes - TransferCount;
  1488.                      Z_PutString (attn)
  1489.                   END
  1490.            ELSE   BEGIN
  1491.                     c := ZERROR;
  1492.                     GOTO err
  1493.                   END
  1494.       END; {case}
  1495.  
  1496.       IF (zdispproc <> NIL) THEN CallUserProcedure (zdispproc);
  1497.  
  1498.    UNTIL (NOT done);
  1499.  
  1500. err:
  1501.  
  1502.    IF (zdispproc <> NIL) THEN CallUserProcedure (zdispproc);
  1503.  
  1504.    RZ_ReceiveFile := ZERROR
  1505. END;
  1506.  
  1507.  
  1508. (*************************************************************************)
  1509.  
  1510. FUNCTION RZ_ReceiveBatch : INTEGER;
  1511.  
  1512.   VAR
  1513.     s    : STRING;
  1514.     c    : INTEGER;
  1515.     done : BOOLEAN;
  1516.  
  1517. BEGIN
  1518.    done := FALSE;
  1519.  
  1520.    WHILE NOT (done) DO BEGIN
  1521.  
  1522.       IF NOT (CarrierDetector (modemkanal)) THEN BEGIN
  1523.         RZ_ReceiveBatch := ZERROR;
  1524.         Exit
  1525.       END;
  1526.  
  1527.       c := RZ_ReceiveFile;
  1528.  
  1529.       Z_CloseFile (outfile);
  1530.       Reset (outfile);
  1531.       IF (IOResult = 0) THEN BEGIN
  1532.         SetFTime (outfile,ftime);
  1533.         Close (outfile);
  1534.       END;  (* of IF *)
  1535.  
  1536.       CASE c OF
  1537.          ZEOF,
  1538.          ZSKIP : BEGIN
  1539.                    c := RZ_InitReceiver;
  1540.                    CASE c OF
  1541.                        ZFILE : BEGIN
  1542.                                  TransferCount:=0;
  1543.                                  TransferBytes:=0;
  1544.                                  TransferError:=0;
  1545.                                  TransferCheck:='';
  1546.                                  TransferMessage:='';
  1547.                                  TransferTime:=TimeCounter;
  1548.                                  TransferMessage:='Wait for File';
  1549.                                  FileAddition:=NewFile;
  1550.                                END;
  1551.                       ZCOMPL : BEGIN
  1552.                                  RZ_AckBibi;
  1553.                                  RZ_ReceiveBatch := ZOK;
  1554.                                  TransferMessage:='Transfer complet';
  1555.                                  Exit
  1556.                                END;
  1557.                         ELSE   BEGIN
  1558.                                  RZ_ReceiveBatch := ZERROR;
  1559.                                  Exit
  1560.                                END
  1561.                    END;  (* of CASE *)
  1562.                  END
  1563.           ELSE   BEGIN
  1564.                    RZ_ReceiveBatch := c;
  1565.                    Exit
  1566.                   END
  1567.       END;  {case}
  1568.  
  1569.       IF (zdispproc <> NIL) THEN CallUserProcedure (zdispproc);
  1570.  
  1571.    END;  {while}
  1572. END;
  1573.  
  1574.  
  1575. (*************************************************************************)
  1576.  
  1577. PROCEDURE ZmodemReceive;
  1578.  
  1579. VAR
  1580.    i: INTEGER;
  1581.  
  1582. BEGIN
  1583.    TransferCount:=0;
  1584.    TransferError:=0;
  1585.    TransferBlockSize:=0;
  1586.    TransferCheck:='';
  1587.    TransferMessage:='';
  1588.  
  1589.    zstartproc:=startproc;
  1590.    zdispproc:=dispproc;
  1591.  
  1592.    IF (kanal <> 0) THEN BEGIN
  1593.      IF (baudrate <> 0) THEN
  1594.        zbaud := baudrate
  1595.      ELSE zbaud:=GetBaudrate (kanal);
  1596.  
  1597.      modemkanal:=kanal;
  1598.      zrxpath := path;
  1599.      IF (zrxpath [Length (zrxpath)] <> '\') AND (zrxpath <> '') THEN zrxpath:=zrxpath + '\';
  1600.  
  1601.      rxtimeout := 10 * 18;
  1602.      tryzhdrtype := ZRINIT;
  1603.  
  1604.      {$IFDEF TPZLog}
  1605.        Assign (tpzlog,'TPZR.LOG');
  1606.        Rewrite (tpzlog);
  1607.      {$ENDIF}
  1608.  
  1609.      i := RZ_InitReceiver;
  1610.  
  1611.      TransferTime:=TimeCounter;
  1612.  
  1613.      IF (i = ZCOMPL) OR ((i = ZFILE) AND (RZ_ReceiveBatch = ZOK)) THEN BEGIN
  1614.        fehlerflag := TRUE
  1615.      END
  1616.      ELSE BEGIN
  1617.        Z_SendCan;
  1618.        fehlerflag := FALSE;
  1619.      END;
  1620.  
  1621.      {$IFDEF TPZLog}
  1622.        Close (tpzlog);
  1623.      {$ENDIF}
  1624.  
  1625.    END  (* of IF THEN *)
  1626.    ELSE BEGIN
  1627.      TransferMessage:='no seriell port';
  1628.      fehlerflag:=FALSE;
  1629.    END;  (* of ELSE *)
  1630.  
  1631.    IF (zdispproc <> NIL) THEN CallUserProcedure (zdispproc);
  1632. END;
  1633.  
  1634.  
  1635. (*######### SEND ROUTINES #####################################*)
  1636.  
  1637. VAR
  1638.    infile     : FILE;
  1639.    strtpos    : LONGINT;
  1640.    rxbuflen   : INTEGER;
  1641.    txbuf      : buftype;
  1642.    blkred     : INTEGER;
  1643.  
  1644.    fheaderlen : WORD;
  1645.  
  1646.  
  1647. PROCEDURE SZ_Z_SendByte(b: BYTE);
  1648.  
  1649. BEGIN
  1650.   IF ((b AND $7F) IN [16,17,19,24]) OR (((b AND $7F) = 13) AND ((lastsent AND $7F) = 64)) THEN BEGIN
  1651.     Z_SendByte (ZDLE);
  1652.     lastsent := (b XOR 64)
  1653.   END
  1654.   ELSE lastsent := b;
  1655.   Z_SendByte (lastsent)
  1656. END;
  1657.  
  1658.  
  1659. (*************************************************************************)
  1660.  
  1661. PROCEDURE SZ_SendBinaryHeader (htype : BYTE ; VAR hdr : hdrtype);
  1662.  
  1663.   VAR
  1664.     crc   : WORD;
  1665.  
  1666.     crc32 : LONGINT;
  1667.  
  1668.     n     : INTEGER;
  1669.  
  1670. BEGIN
  1671.   Z_SendByte (ZPAD);
  1672.   Z_SendByte (ZDLE);
  1673.  
  1674.   IF send32crc THEN BEGIN
  1675.     Z_SendByte (ZBIN32);
  1676.     SZ_Z_SendByte (htype);
  1677.  
  1678.     crc32 := UpdC32 (htype,$FFFFFFFF);
  1679.  
  1680.     FOR n := 0 TO 3 DO BEGIN
  1681.        SZ_Z_SendByte (hdr [n]);
  1682.        crc32:=UpdC32 (hdr [n],crc32)
  1683.     END;
  1684.  
  1685.     crc32:=NOT (crc32);
  1686.  
  1687.     FOR n := 0 TO 3 DO BEGIN
  1688.       SZ_Z_SendByte (BYTE (crc32));
  1689.       crc32 := (crc32 SHR 8)
  1690.     END;
  1691.  
  1692.   END  (* of IF THEN *)
  1693.   ELSE BEGIN
  1694.     Z_SendByte (ZBIN);
  1695.     SZ_Z_SendByte (htype);
  1696.  
  1697.     crc := UpdCrc (htype,0);
  1698.  
  1699.     FOR n := 0 TO 3 DO BEGIN
  1700.        SZ_Z_SendByte (hdr [n]);
  1701.        crc:=UpdCrc (hdr [n],crc)
  1702.     END;
  1703.  
  1704.     crc := UpdCrc (0,crc);
  1705.     crc := UpdCrc (0,crc);
  1706.  
  1707.     SZ_Z_SendByte (Lo (crc SHR 8));
  1708.     SZ_Z_SendByte (Lo (crc));
  1709.   END;  (* of ELSE *)
  1710.  
  1711.   IF (htype <> ZDATA) THEN Delay (500)
  1712. END;
  1713.  
  1714.  
  1715. (*************************************************************************)
  1716.  
  1717. PROCEDURE SZ_SendData (VAR buf : buftype ; blength : INTEGER ; frameend : BYTE);
  1718.  
  1719.   VAR
  1720.     crc   : WORD;
  1721.  
  1722.     crc32 : LONGINT;
  1723.  
  1724.     t     : INTEGER;
  1725.  
  1726. BEGIN
  1727.   IF send32crc THEN BEGIN
  1728.     crc32 := $FFFFFFFF;
  1729.  
  1730.     FOR t := 0 TO (blength - 1) DO BEGIN
  1731.       SZ_Z_SendByte (buf [t]);
  1732.       crc32 := UpdC32 (buf [t],crc32)
  1733.     END;
  1734.  
  1735.     crc32 := UpdC32 (frameend,crc32);
  1736.     crc32 := (NOT crc32);
  1737.  
  1738.     Z_SendByte (ZDLE);
  1739.     Z_SendByte (frameend);
  1740.  
  1741.     FOR t := 0 TO 3 DO BEGIN
  1742.       SZ_Z_SendByte (BYTE (crc32));
  1743.       crc32 := (crc32 SHR 8)
  1744.     END;  (* of FOR *)
  1745.   END  (* of IF THEN *)
  1746.   ELSE BEGIN
  1747.     crc := 0;
  1748.  
  1749.     FOR t := 0 TO (blength - 1) DO BEGIN
  1750.       SZ_Z_SendByte (buf [t]);
  1751.       crc := UpdCrc (buf [t],crc)
  1752.     END;
  1753.  
  1754.     crc := UpdCrc(frameend,crc);
  1755.  
  1756.     Z_SendByte (ZDLE);
  1757.     Z_SendByte (frameend);
  1758.  
  1759.     crc := UpdCrc (0,crc);
  1760.     crc := UpdCrc (0,crc);
  1761.  
  1762.     SZ_Z_SendByte (Lo (crc SHR 8));
  1763.     SZ_Z_SendByte (Lo (crc));
  1764.  
  1765.   END;  (* of ELSE *)
  1766.  
  1767.   IF (frameend = ZCRCW) THEN BEGIN
  1768.     Z_SendByte (17);
  1769.     Delay (500)
  1770.   END;  (* of IF *)
  1771.  
  1772. END;  (* of SZ_SendData *)
  1773.  
  1774.  
  1775. (*************************************************************************)
  1776.  
  1777. PROCEDURE SZ_EndSend;
  1778.  
  1779.   VAR
  1780.     done : BOOLEAN;
  1781.  
  1782. BEGIN
  1783.    done := FALSE;
  1784.    REPEAT
  1785.       Z_PutLongIntoHeader (txpos);
  1786.       SZ_SendBinaryHeader (ZFIN,txhdr);
  1787.       CASE Z_GetHeader (rxhdr) OF
  1788.              ZFIN : BEGIN
  1789.                       Z_SendByte (Ord ('O'));
  1790.                       Z_SendByte (Ord ('O'));
  1791.                       Delay (500);
  1792.                       Exit
  1793.                     END;
  1794.              ZCAN,
  1795.              RCDO,
  1796.             ZFERR,
  1797.          ZTIMEOUT : Exit
  1798.       END {case}
  1799.    UNTIL (done);
  1800. END;
  1801.  
  1802.  
  1803. (*************************************************************************)
  1804.  
  1805. FUNCTION SZ_GetReceiverInfo: INTEGER;
  1806.  
  1807.   VAR
  1808.     n,
  1809.     c,
  1810.     rxflags : INTEGER;
  1811.  
  1812. BEGIN
  1813.    FOR n := 1 TO 10 DO BEGIN
  1814.       c := Z_GetHeader (rxhdr);
  1815.       CASE c OF
  1816.          ZCHALLENGE: BEGIN
  1817.                        Z_PutLongIntoHeader (rxpos);
  1818.                        Z_SendHexHeader (ZACK,txhdr)
  1819.                      END;
  1820.            ZCOMMAND: BEGIN
  1821.                        Z_PutLongIntoHeader (LONGINT (0));
  1822.                        Z_SendHexHeader (ZRQINIT,txhdr)
  1823.                      END;
  1824.              ZRINIT: BEGIN
  1825.                        rxbuflen := (WORD (rxhdr [ZP1]) SHL 8) OR rxhdr [ZP0];
  1826.                        send32crc:=MakeCRC32 AND ((rxhdr [ZF0] AND CANFC32) <> 0);
  1827.                        IF send32crc THEN
  1828.                          TransferCheck:='CRC-32'
  1829.                        ELSE TransferCheck:='CRC-16';
  1830.                        SZ_GetReceiverInfo := ZOK;
  1831.                        Exit
  1832.                      END;
  1833.            ZCAN,
  1834.            RCDO,
  1835.            ZTIMEOUT: BEGIN
  1836.                        SZ_GetReceiverInfo := ZERROR;
  1837.                        Exit
  1838.                      END
  1839.            ELSE      IF (c <> ZRQINIT) OR (rxhdr [ZF0] <> ZCOMMAND) THEN Z_SendHexHeader (ZNAK,txhdr)
  1840.       END {case}
  1841.    END; {for}
  1842.    SZ_GetReceiverInfo := ZERROR
  1843. END;
  1844.  
  1845.  
  1846. (*************************************************************************)
  1847.  
  1848. FUNCTION SZ_SyncWithReceiver: INTEGER;
  1849.  
  1850.   VAR
  1851.     c,
  1852.     num_errs : INTEGER;
  1853.  
  1854.     numstr   : STRING [10];
  1855.  
  1856.     done     : BOOLEAN;
  1857.  
  1858. BEGIN
  1859.    num_errs := 7;
  1860.    done := FALSE;
  1861.  
  1862.    REPEAT
  1863.       c := Z_GetHeader (rxhdr);
  1864.       ClearSeriellBuffer (modemkanal);
  1865.       CASE c OF
  1866.          ZTIMEOUT : BEGIN
  1867.                       DEC (num_errs);
  1868.                       IF (num_errs < 0) THEN BEGIN
  1869.                         TransferMessage:='Timeout';
  1870.                         SZ_SyncWithReceiver := ZERROR;
  1871.                         Exit
  1872.                       END
  1873.                     END;
  1874.              ZCAN,
  1875.            ZABORT,
  1876.              ZFIN,
  1877.              RCDO : BEGIN
  1878.                       TransferMessage:='Abord';
  1879.                       SZ_SyncWithReceiver := ZERROR;
  1880.                       Exit
  1881.                     END;
  1882.             ZRPOS : BEGIN
  1883.                       IF NOT (Z_SeekFile (infile,rxpos)) THEN BEGIN
  1884.                         TransferMessage:='File seek error';
  1885.                         SZ_SyncWithReceiver := ZERROR;
  1886.                       END  (* of IF THEN *)
  1887.                       ELSE BEGIN
  1888.                         Str (rxpos,numstr);
  1889.                         TransferMessage:=numstr + ' : Bad CRC';
  1890.                         txpos := rxpos;
  1891.                         SZ_SyncWithReceiver := c;
  1892.                       END;  (* of ELSE *)
  1893.                       Exit
  1894.                     END;
  1895.             ZSKIP,
  1896.            ZRINIT,
  1897.              ZACK : BEGIN
  1898.                       TransferMessage:='Wait for file';
  1899.                       SZ_SyncWithReceiver := c;
  1900.                       Exit
  1901.                     END
  1902.              ELSE   BEGIN
  1903.                       TransferMessage:='I dunno what happened';
  1904.                       SZ_SendBinaryHeader (ZNAK,txhdr)
  1905.                     END
  1906.       END {case}
  1907.    UNTIL (done)
  1908. END;
  1909.  
  1910.  
  1911. (*************************************************************************)
  1912.  
  1913. FUNCTION SZ_SendFileData: INTEGER;
  1914.  
  1915. LABEL
  1916.    waitack, somemore;
  1917.  
  1918. VAR
  1919.    c,e        : INTEGER;
  1920.  
  1921.    newcnt,
  1922.    blklen,
  1923.    blkred,
  1924.    maxblklen,
  1925.    goodblks,
  1926.    goodneeded : WORD;
  1927.  
  1928.    ch         : CHAR;
  1929.  
  1930.    stop,
  1931.    chflag     : BOOLEAN;
  1932.  
  1933. BEGIN
  1934.    goodneeded := 1;
  1935.  
  1936.    IF (zbaud < 300) THEN
  1937.       maxblklen := 128
  1938.    ELSE maxblklen := (WORD (zbaud) DIV 300) * 256;
  1939.  
  1940.    IF (maxblklen > ZBUFSIZE) THEN maxblklen:=ZBUFSIZE;
  1941.    IF (rxbuflen > 0) AND (rxbuflen < maxblklen) THEN maxblklen:=rxbuflen;
  1942.  
  1943.    blklen := maxblklen;
  1944.  
  1945.    TransferBlockSize:=blklen;
  1946.  
  1947.    ztime := TimeCounter DIV 18;
  1948.  
  1949. somemore:
  1950.  
  1951.    stop:=FALSE;
  1952.  
  1953.    REPEAT
  1954.      SeriellCheckRead (modemkanal,ch,chflag);
  1955.      IF chflag THEN BEGIN
  1956.        IF (ch = CHR (XOFF)) OR (ch = CHR (XON)) THEN BEGIN
  1957.          ch:=SeriellRead (modemkanal);
  1958.          {$IFDEF TPZLog}
  1959.            Write (tpzlog,CHAR (c));
  1960.          {$ENDIF}
  1961.        END  (* of IF THEN *)
  1962.        ELSE stop:=TRUE;
  1963.      END  (* of IF THEN *)
  1964.      ELSE stop:=TRUE;
  1965.    UNTIL stop;
  1966.  
  1967.    IF chflag THEN BEGIN
  1968.  
  1969. WaitAck:
  1970.  
  1971.       c := SZ_SyncWithReceiver;
  1972.  
  1973.       CASE c OF
  1974.           ZSKIP : BEGIN
  1975.                     SZ_SendFileData := ZSKIP;
  1976.                     Exit
  1977.                   END;
  1978.            ZACK : {null};
  1979.           ZRPOS : BEGIN
  1980.                     INC (TransferError);
  1981.                     IF ((blklen SHR 2) > 32) THEN
  1982.                        blklen := (blklen SHR 2)
  1983.                     ELSE blklen := 32;
  1984.                     goodblks := 0;
  1985.                     goodneeded := (goodneeded SHL 1) OR 1;
  1986.                     TransferBlockSize:=blklen;
  1987.                   END;
  1988.          ZRINIT : BEGIN
  1989.                     SZ_SendFileData := ZOK;
  1990.                     Exit
  1991.                   END
  1992.            ELSE   BEGIN
  1993.                     SZ_SendFileData := ZERROR;
  1994.                     Exit
  1995.                   END
  1996.       END {case};
  1997.  
  1998.       WHILE ReceiverReady (modemkanal) DO BEGIN
  1999.          CASE Z_GetByte (2) OF
  2000.             CAN,
  2001.             ZPAD: GOTO waitack;
  2002.             RCDO: BEGIN
  2003.                     SZ_SendFileData := ZERROR;
  2004.                     Exit
  2005.                   END
  2006.          END {case}
  2007.       END;  (* of WHILE *)
  2008.    END; {if char avail}
  2009.  
  2010.    newcnt:=rxbuflen;
  2011.    Z_PutLongIntoHeader (txpos);
  2012.    SZ_SendBinaryHeader (ZDATA,txhdr);
  2013.  
  2014.    REPEAT
  2015.       IF (KeyPressed) THEN BEGIN
  2016.         IF (ReadKey = #27) THEN BEGIN
  2017.           TransferMessage:='Aborted from keyboard';
  2018.           SZ_SendFileData := ZERROR;
  2019.           Exit
  2020.         END;
  2021.       END;  (* of IF *)
  2022.  
  2023.       IF NOT (CarrierDetector (modemkanal)) THEN BEGIN
  2024.         TransferMessage:='Carrier lost';
  2025.         SZ_SendFileData := ZERROR;
  2026.         Exit;
  2027.       END;  (* of IF *)
  2028.  
  2029.       IF NOT (Z_ReadFile (infile,txbuf,blklen,blkred)) THEN BEGIN
  2030.         TransferMessage:='Error reading disk';
  2031.         SZ_SendFileData := ZERROR;
  2032.         Exit
  2033.       END;
  2034.  
  2035.       IF (blkred < blklen) THEN
  2036.         e := ZCRCE
  2037.       ELSE IF (rxbuflen <> 0) AND ((newcnt - blkred) <= 0) THEN BEGIN
  2038.         newcnt := (newcnt - blkred);
  2039.         e := ZCRCW
  2040.       END
  2041.       ELSE e := ZCRCG;
  2042.  
  2043.       SZ_SendData (txbuf,blkred,e);
  2044.       INC (txpos,blkred);
  2045.  
  2046.       INC (goodblks);
  2047.       IF (blklen < maxblklen) AND (goodblks > goodneeded) THEN BEGIN
  2048.         IF ((blklen SHL 1) < maxblklen) THEN
  2049.           blklen := (blklen SHL 1)
  2050.         ELSE blklen := maxblklen;
  2051.         goodblks := 0
  2052.       END;  (* of IF *)
  2053.  
  2054.       TransferBlockSize:=blklen;
  2055.       TransferBytes:=txpos - TransferCount;
  2056.  
  2057.       IF (zdispproc <> NIL) THEN CallUserProcedure (zdispproc);
  2058.  
  2059.       IF (e = ZCRCW) THEN GOTO waitack;
  2060.  
  2061.       WHILE ReceiverReady (modemkanal) DO BEGIN
  2062.          CASE Z_GetByte (2) OF
  2063.             CAN,
  2064.             ZPAD : BEGIN
  2065.                      TransferMessage:='Trouble';
  2066.                      SZ_SendData (txbuf,0,ZCRCE);
  2067.                      GOTO waitack
  2068.                    END;
  2069.             RCDO : BEGIN
  2070.                      SZ_SendFileData := ZERROR;
  2071.                      Exit
  2072.                    END
  2073.          END; {case}
  2074.       END; (* of WHILE *)
  2075.  
  2076.    UNTIL (e <> ZCRCG);
  2077.  
  2078.    stop:=FALSE;
  2079.    REPEAT
  2080.       Z_PutLongIntoHeader (txpos);
  2081.       SZ_SendBinaryHeader (ZEOF,txhdr);
  2082.       c := SZ_SyncWithReceiver;
  2083.       CASE c OF
  2084.            ZACK : stop:=TRUE;
  2085.           ZRPOS : GOTO somemore;
  2086.          ZRINIT : BEGIN
  2087.                     SZ_SendFileData := ZOK;
  2088.                     TransferMessage:='Transfer complet';
  2089.                     stop:=TRUE;
  2090.                   END;
  2091.           ZSKIP : BEGIN
  2092.                     SZ_SendFileData := c;
  2093.                     TransferMessage:='Skip file';
  2094.                     stop:=TRUE;
  2095.                   END
  2096.          ELSE     BEGIN
  2097.                     SZ_SendFileData := ZERROR;
  2098.                     stop:=TRUE;
  2099.                   END
  2100.       END; {case}
  2101.  
  2102.       IF (zdispproc <> NIL) THEN CallUserProcedure (zdispproc);
  2103.  
  2104.    UNTIL (c <> ZACK)
  2105. END;
  2106.  
  2107.  
  2108. (*************************************************************************)
  2109.  
  2110. FUNCTION SZ_SendFile : INTEGER;
  2111.  
  2112.   VAR
  2113.     c    : INTEGER;
  2114.     done : BOOLEAN;
  2115.  
  2116. BEGIN
  2117.    TransferError:=0;
  2118.    TransferBytes:=0;
  2119.  
  2120.    done := FALSE;
  2121.  
  2122.    REPEAT
  2123.       IF (KeyPressed) THEN BEGIN
  2124.         IF (ReadKey = #27) THEN BEGIN
  2125.           TransferMessage:='Aborted from keyboard';
  2126.           SZ_SendFile := ZERROR;
  2127.           Exit
  2128.         END;
  2129.       END;  (* of IF *)
  2130.  
  2131.       IF NOT (CarrierDetector (modemkanal)) THEN BEGIN
  2132.         TransferMessage:='Lost carrier';
  2133.         SZ_SendFile := ZERROR;
  2134.         Exit
  2135.       END;
  2136.  
  2137.       FillChar (txhdr,4,0);
  2138.  
  2139.       txhdr [ZF0] := ZCRESUM;                       (* Recover zulassen *)
  2140.  
  2141.       SZ_SendBinaryHeader (ZFILE,txhdr);
  2142.  
  2143.       SZ_SendData (txbuf,fheaderlen,ZCRCW);
  2144.  
  2145.       Delay (500);
  2146.  
  2147.       REPEAT
  2148.          c := Z_GetHeader (rxhdr);
  2149.          CASE c OF
  2150.             ZCAN,
  2151.             RCDO,
  2152.             ZTIMEOUT,
  2153.             ZFIN,
  2154.             ZABORT: BEGIN
  2155.                        SZ_SendFile := ZERROR;
  2156.                        Exit
  2157.                     END;
  2158.             ZRINIT : {null - this will cause a loopback};
  2159.               ZCRC : BEGIN
  2160.                        Z_PutLongIntoHeader (Z_FileCRC32 (infile));
  2161.                        Z_SendHexHeader (ZCRC,txhdr)
  2162.                      END;
  2163.              ZSKIP : BEGIN
  2164.                        SZ_SendFile := c;
  2165.                        Exit
  2166.                      END;
  2167.              ZRPOS : BEGIN
  2168.                        IF (NOT Z_SeekFile (infile,rxpos)) THEN BEGIN
  2169.                           TransferMessage:='File positioning error';
  2170.                           Z_SendHexHeader (ZFERR,txhdr);
  2171.                           SZ_SendFile := ZERROR;
  2172.                           Exit
  2173.                        END;
  2174.  
  2175.                        IF (rxpos = 0) THEN FileAddition:=NewFile ELSE FileAddition:=RecoverFile;
  2176.  
  2177.                        TransferCount:=rxpos;
  2178.                        IF (zstartproc <> NIL) THEN CallUserProcedure (zstartproc);
  2179.                        strtpos := rxpos;
  2180.                        txpos := rxpos;
  2181.                        SZ_SendFile := SZ_SendFileData;
  2182.                        Exit;
  2183.                     END
  2184.          END {case}
  2185.       UNTIL (c <> ZRINIT);
  2186.    UNTIL (done);
  2187. END;
  2188.  
  2189.  
  2190. (*************************************************************************)
  2191.  
  2192. PROCEDURE ZmodemSend;
  2193.  
  2194. VAR
  2195.    s: STRING;
  2196.    n: INTEGER;
  2197.  
  2198. BEGIN
  2199.    TransferError := 0;
  2200.    TransferTime:=0;
  2201.    TransferCount:=0;
  2202.    TransferBytes:=0;
  2203.    TransferName:='';
  2204.    TransferCheck:='';
  2205.    TransferSize:=0;
  2206.    TransferBlockSize:=0;
  2207.    TransferMessage:='';
  2208.    FileAddition:=NewFile;
  2209.  
  2210.    zstartproc:=startproc;
  2211.    zdispproc:=dispproc;
  2212.  
  2213.    IF (kanal <> 0) THEN BEGIN
  2214.      IF (baudrate <> 0) THEN
  2215.        zbaud := baudrate
  2216.      ELSE zbaud:=GetBaudrate (kanal);
  2217.  
  2218.      modemkanal:=kanal;
  2219.      IF NOT (CarrierDetector (modemkanal)) THEN BEGIN
  2220.        TransferMessage:='Lost carrier';
  2221.        IF (zdispproc <> NIL) THEN CallUserProcedure (zdispproc);
  2222.        fehler:=103;
  2223.        Exit
  2224.      END;
  2225.  
  2226.      IF (NOT Z_FindFile(pathname,fname,fsize,ftime)) THEN BEGIN
  2227.        TransferMessage:='Unable to find/open file';
  2228.        IF (zdispproc <> NIL) THEN CallUserProcedure (zdispproc);
  2229.        fehler:=10;
  2230.        Exit
  2231.      END;
  2232.  
  2233.      TransferName:=fname;
  2234.      TransferSize:=fsize;
  2235.      TransferTotalTime:=fsize DIV (zbaud DIV 10);
  2236.  
  2237.      Str (fsize,s);
  2238.      s:=fname + #0 + s + ' ';
  2239.      s:=s + Z_ToUnixDate (ftime);
  2240.      FOR n:=1 TO Length (s) DO BEGIN
  2241.        IF (s [n] IN ['A'..'Z']) THEN s [n]:=Chr (Ord (s [n]) + $20)
  2242.      END;
  2243.  
  2244.  
  2245.      FillChar (txbuf,ZBUFSIZE,0);
  2246.      Move (s [1],txbuf [0],Length (s));
  2247.      fheaderlen:=Length (s);
  2248.  
  2249.      IF (zbaud > 0) THEN
  2250.         rxtimeout := INTEGER ((614400 DIV zbaud) * 10) DIV 18
  2251.      ELSE rxtimeout := 180;
  2252.      IF (rxtimeout < 180) THEN rxtimeout := 180;
  2253.  
  2254.      attn [0] := Ord('r');
  2255.      attn [1] := Ord('z');
  2256.      attn [3] := 13;
  2257.      attn [4] := 0;
  2258.  
  2259.      {$IFDEF TPZLog}
  2260.        Assign (tpzlog,'TPZS.LOG');
  2261.        Rewrite (tpzlog);
  2262.      {$ENDIF}
  2263.  
  2264.      Z_PutString (attn);
  2265.      FillChar (attn,SizeOf (attn),0);
  2266.      Z_PutLongIntoHeader (LONGINT (0));
  2267.  
  2268.      TransferTime:=TimeCounter;
  2269.  
  2270.      Z_SendHexHeader (ZRQINIT,txhdr);
  2271.  
  2272.      IF (SZ_GetReceiverInfo = ZERROR) THEN BEGIN
  2273.        fehler:=102;
  2274.      END  (* of IF THEN *)
  2275.      ELSE BEGIN
  2276.        IF NOT (Z_OpenFile (infile,pathname)) THEN BEGIN
  2277.          IF (IOresult <> 0) THEN BEGIN
  2278.            TransferMessage:='Failure to open file';
  2279.            Z_SendCan;
  2280.            fehler:=101;
  2281.          END;  (* of IF *)
  2282.        END  (* of IF THEN *)
  2283.        ELSE BEGIN
  2284.          n := SZ_SendFile;
  2285.          Z_CloseFile (infile);
  2286.  
  2287.          CASE n OF
  2288.            ZSKIP : fehler:=9;
  2289.              ZOK : fehler:=0;
  2290.             ZCAN : fehler:=8;
  2291.          END;  (* of CASE *)
  2292.  
  2293.          IF (n = ZERROR) THEN
  2294.            Z_SendCan
  2295.          ELSE IF lastfile THEN SZ_EndSend;
  2296.  
  2297.        END;  (* of ELSE *)
  2298.  
  2299.      END;  (* of ELSE *)
  2300.  
  2301.      {$IFDEF TPZLog}
  2302.        Close (tpzlog);
  2303.      {$ENDIF}
  2304.  
  2305.    END  (* of IF THEN *)
  2306.    ELSE BEGIN
  2307.      TransferMessage:='no seriell port';
  2308.      fehler:=105;
  2309.    END;  (* of ELSE *)
  2310.  
  2311.    IF (zdispproc <> NIL) THEN CallUserProcedure (zdispproc);
  2312. END;
  2313.  
  2314.  
  2315. (*************************************************************************)
  2316.  
  2317. BEGIN
  2318.   MakeCRC32:=TRUE;
  2319.   RecoverAllow:=TRUE;
  2320. END.